home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacMETH 3.2.1 / Coroutines / Thread.MOD < prev   
Encoding:
Modula Implementation  |  1994-04-20  |  12.0 KB  |  373 lines  |  [TEXT/MEDT]
  1. IMPLEMENTATION MODULE Thread;
  2.   (*
  3.         Implementation and Revisions:
  4.         ============================
  5.  
  6.         Author  Date        Description
  7.         ------  ----        -----------
  8.  
  9.         JT      30/3/94    First implementation (MacMETH_V3.2)
  10.  
  11.   *)
  12.  
  13.  
  14.   FROM SYSTEM IMPORT
  15.     REG, INLINE, VAL, WORD, ADDRESS, SETREG;
  16.  
  17.   CONST
  18.     D0         = 0;
  19.     ThreadTrap = 0ABF2H;
  20.   VAR
  21.     threadsAvailable : BOOLEAN;
  22.  
  23. (* Thread Manager routines *)
  24.   PROCEDURE CreateThreadPool(threadStyle: ThreadStyle; numToCreate: INTEGER; stackSize: Size):OSErr;
  25.  
  26.     PROCEDURE TBCreateThreadPool(threadStyle: ThreadStyle;
  27.                                  numToCreate: INTEGER;
  28.                                  stackSize: Size           ):OSErr; CODE ThreadTrap;
  29.     
  30.   BEGIN
  31.     INLINE( 0303CH,00501H);
  32.     RETURN TBCreateThreadPool(threadStyle, numToCreate, stackSize);
  33.   END CreateThreadPool;
  34.  
  35.  
  36.   PROCEDURE GetFreeThreadCount(threadStyle: ThreadStyle; VAR freeCount: INTEGER):OSErr;
  37.     PROCEDURE TBGetFreeThreadCount(    threadStyle: ThreadStyle;
  38.                                    VAR freeCount: INTEGER):OSErr ; CODE ThreadTrap;
  39.     
  40.   BEGIN
  41.     INLINE( 0303CH,00402H);
  42.     RETURN TBGetFreeThreadCount(threadStyle, freeCount);
  43.   END GetFreeThreadCount;
  44.  
  45.  
  46.   PROCEDURE GetSpecificFreeThreadCount ( threadStyle: ThreadStyle; stackSize: Size; VAR freeCount: INTEGER):OSErr;
  47.     PROCEDURE TBGetSpecificFreeThreadCount (    threadStyle: ThreadStyle;
  48.                                                 stackSize: Size;
  49.                                             VAR freeCount: INTEGER     ):OSErr; CODE ThreadTrap;
  50.     
  51.   BEGIN
  52.     INLINE( 0303CH,00615H);
  53.     RETURN TBGetSpecificFreeThreadCount(threadStyle, stackSize, freeCount);
  54.   END GetSpecificFreeThreadCount;
  55.  
  56.     
  57.   PROCEDURE GetDefaultThreadStackSize(threadStyle: ThreadStyle; VAR stackSize: Size):OSErr;
  58.     PROCEDURE TBGetDefaultThreadStackSize(    threadStyle: ThreadStyle;
  59.                                           VAR stackSize: Size          ):OSErr; CODE ThreadTrap;
  60.     
  61.   BEGIN
  62.     INLINE( 0303CH,00413H);
  63.     RETURN TBGetDefaultThreadStackSize(threadStyle,  stackSize);
  64.   END GetDefaultThreadStackSize;
  65.  
  66.  
  67.   PROCEDURE ThreadCurrentStackSpace(thread: ThreadID; VAR freeStack: LONGINT):OSErr;
  68.     PROCEDURE TBThreadCurrentStackSpace(thread: ThreadID; VAR freeStack: LONGINT):OSErr; CODE ThreadTrap;
  69.     
  70.   BEGIN
  71.     INLINE( 0303CH,00414H);
  72.     RETURN TBThreadCurrentStackSpace(thread, freeStack);
  73.   END ThreadCurrentStackSpace;
  74.  
  75.  
  76.   PROCEDURE NewThread(threadStyle: ThreadStyle; threadEntry: ThreadEntryProcPtr; threadParam: LONGINT; stackSize: Size; options: ThreadOptions; threadResult: LongIntPtr; VAR threadMade: ThreadID):OSErr;
  77.     PROCEDURE TBNewThread(threadStyle: ThreadStyle;
  78.                           threadEntry: ThreadEntryProcPtr;
  79.                           threadParam: LONGINT;
  80.                           stackSize: Size;
  81.                           options: ThreadOptions;
  82.                           threadResult: LongIntPtr;
  83.                           VAR threadMade: ThreadID):OSErr; CODE ThreadTrap;
  84.     
  85.   BEGIN
  86.     INLINE( 0303CH,00E03H);
  87.     RETURN TBNewThread(threadStyle, threadEntry, threadParam,
  88.                        stackSize, options, threadResult, threadMade);
  89.   END NewThread;
  90.  
  91.  
  92.   PROCEDURE DisposeThread(threadToDump: ThreadID; threadResult: LONGINT; recycleThread: BOOLEAN):OSErr;
  93.     PROCEDURE TBDisposeThread(threadToDump: ThreadID;
  94.                               threadResult: LONGINT;
  95.                               recycleThread: BOOLEAN  ):OSErr; CODE ThreadTrap;
  96.     
  97.   BEGIN
  98.     INLINE( 0303CH,00504H);
  99.     RETURN TBDisposeThread(threadToDump, threadResult, recycleThread);
  100.   END DisposeThread;
  101.  
  102.  
  103.   PROCEDURE YieldToThread(suggestedThread: ThreadID):OSErr;
  104.     PROCEDURE TBYieldToThread(suggestedThread: ThreadID):OSErr; CODE ThreadTrap;
  105.     
  106.   BEGIN
  107.     INLINE( 0303CH,00205H);
  108.     RETURN TBYieldToThread(suggestedThread);
  109.   END YieldToThread;
  110.  
  111.  
  112.   PROCEDURE YieldToAnyThread():OSErr;
  113.     PROCEDURE TBYieldToAnyThread():OSErr; CODE ThreadTrap;
  114.     
  115.   BEGIN
  116.     INLINE( 042A7H,0303CH,00205H);
  117.     RETURN TBYieldToAnyThread();
  118.   END YieldToAnyThread;
  119.  
  120.  
  121.   PROCEDURE GetCurrentThread(VAR currentThreadID: ThreadID):OSErr;
  122.     PROCEDURE TBGetCurrentThread(VAR currentThreadID: ThreadID):OSErr; CODE ThreadTrap;
  123.     
  124.   BEGIN
  125.     INLINE( 0303CH,00206H);
  126.     RETURN TBGetCurrentThread(currentThreadID);
  127.   END GetCurrentThread;
  128.  
  129.  
  130.   PROCEDURE GetThreadState(threadToGet: ThreadID; VAR threadState: ThreadState):OSErr;
  131.     PROCEDURE TBGetThreadState(threadToGet: ThreadID; VAR threadState: ThreadState):OSErr; CODE ThreadTrap;
  132.     
  133.   BEGIN
  134.     INLINE( 0303CH,00407H);
  135.     RETURN TBGetThreadState(threadToGet, threadState);
  136.   END GetThreadState;
  137.  
  138.  
  139.   PROCEDURE SetThreadState(threadToSet: ThreadID; newState: ThreadState; suggestedThread: ThreadID):OSErr;
  140.     PROCEDURE TBSetThreadState(threadToSet: ThreadID;
  141.                              newState: ThreadState;
  142.                              suggestedThread: ThreadID):OSErr; CODE ThreadTrap;
  143.     
  144.   BEGIN
  145.     INLINE( 0303CH,00508H);
  146.     RETURN TBSetThreadState(threadToSet, newState, suggestedThread);
  147.   END SetThreadState;
  148.  
  149.  
  150.   PROCEDURE SetThreadStateEndCritical(threadToSet: ThreadID; newState: ThreadState; suggestedThread: ThreadID):OSErr;
  151.     PROCEDURE TBSetThreadStateEndCritical(threadToSet: ThreadID;
  152.                                         newState: ThreadState;
  153.                                         suggestedThread: ThreadID):OSErr; CODE ThreadTrap;
  154.     
  155.   BEGIN
  156.     INLINE( 0303CH,00512H);
  157.     RETURN TBSetThreadStateEndCritical(threadToSet, newState, suggestedThread);
  158.   END SetThreadStateEndCritical;
  159.  
  160.  
  161.   PROCEDURE SetThreadScheduler(threadScheduler: ThreadSchedulerProcPtr):OSErr;
  162.     PROCEDURE TBSetThreadScheduler(threadScheduler: ThreadSchedulerProcPtr):OSErr;  CODE ThreadTrap;
  163.     
  164.   BEGIN
  165.     INLINE( 0303CH,00209H);
  166.     RETURN TBSetThreadScheduler(threadScheduler);
  167.   END SetThreadScheduler;
  168.  
  169.  
  170.   PROCEDURE SetThreadSwitcher(thread: ThreadID; threadSwitcher: ThreadSwitchProcPtr; switchProcParam: LONGINT; inOrOut: BOOLEAN):OSErr;
  171.     PROCEDURE TBSetThreadSwitcher(thread: ThreadID;
  172.                                   threadSwitcher: ThreadSwitchProcPtr;
  173.                                   switchProcParam: LONGINT;
  174.                                   inOrOut: BOOLEAN       ):OSErr; CODE ThreadTrap;
  175.     
  176.   BEGIN
  177.     INLINE( 0303CH,0070AH);
  178.     RETURN TBSetThreadSwitcher(thread, threadSwitcher, switchProcParam, inOrOut);
  179.   END SetThreadSwitcher;
  180.  
  181.  
  182.   PROCEDURE SetThreadTerminator(thread: ThreadID; threadTerminator: ThreadTerminationProcPtr; terminationProcParam: LONGINT):OSErr;
  183.     PROCEDURE TBSetThreadTerminator(thread: ThreadID;
  184.                                     threadTerminator: ThreadTerminationProcPtr;
  185.                                     terminationProcParam: LONGINT):OSErr; CODE ThreadTrap;
  186.     
  187.   BEGIN
  188.     INLINE( 0303CH,00611H);
  189.     RETURN TBSetThreadTerminator(thread, threadTerminator, terminationProcParam);
  190.   END SetThreadTerminator;
  191.  
  192.  
  193.   PROCEDURE ThreadBeginCritical():OSErr;
  194.     PROCEDURE TBThreadBeginCritical():OSErr; CODE ThreadTrap;
  195.     
  196.   BEGIN
  197.     INLINE( 0303CH,0000BH);
  198.     RETURN TBThreadBeginCritical();
  199.   END ThreadBeginCritical;
  200.  
  201.  
  202.   PROCEDURE ThreadEndCritical():OSErr;
  203.     PROCEDURE TBThreadEndCritical():OSErr; CODE ThreadTrap;
  204.     
  205.   BEGIN
  206.     INLINE( 0303CH,0000CH);
  207.     RETURN TBThreadEndCritical();
  208.   END ThreadEndCritical;
  209.  
  210.  
  211.   PROCEDURE SetDebuggerNotificationProcs (    notifyNewThread: DebuggerNewThreadProcPtr;
  212.                                           notifyDisposeThread: DebuggerDisposeThreadProcPtr;
  213.                                           notifyThreadScheduler: DebuggerThreadSchedulerProcPtr ):OSErr;
  214.     PROCEDURE TBSetDebuggerNotificationProcs (notifyNewThread: DebuggerNewThreadProcPtr;
  215.                                                 notifyDisposeThread: DebuggerDisposeThreadProcPtr;
  216.                                                 notifyThreadScheduler: DebuggerThreadSchedulerProcPtr ):OSErr; CODE ThreadTrap;
  217.     
  218.   BEGIN
  219.     INLINE( 0303CH,0060DH);
  220.     RETURN TBSetDebuggerNotificationProcs (notifyNewThread,
  221.                                            notifyDisposeThread,
  222.                                            notifyThreadScheduler);
  223.   END SetDebuggerNotificationProcs;
  224.  
  225.  
  226.   PROCEDURE GetThreadCurrentTaskRef ( VAR threadTRef: ThreadTaskRef ):OSErr;
  227.     PROCEDURE TBGetThreadCurrentTaskRef ( VAR threadTRef: ThreadTaskRef ):OSErr; CODE ThreadTrap;
  228.     
  229.   BEGIN
  230.     INLINE( 0303CH,0020EH);
  231.     RETURN TBGetThreadCurrentTaskRef(threadTRef);
  232.   END GetThreadCurrentTaskRef;
  233.  
  234.  
  235.   PROCEDURE GetThreadStateGivenTaskRef ( threadTRef: ThreadTaskRef; threadToGet: ThreadID; VAR threadState: ThreadState ):OSErr;
  236.     PROCEDURE TBGetThreadStateGivenTaskRef (    threadTRef: ThreadTaskRef;
  237.                                                 threadToGet: ThreadID;
  238.                                             VAR threadState: ThreadState ):OSErr; CODE ThreadTrap;
  239.     
  240.   BEGIN
  241.     INLINE( 0303CH,0060FH);
  242.     RETURN TBGetThreadStateGivenTaskRef (threadTRef, threadToGet, threadState);
  243.   END GetThreadStateGivenTaskRef;
  244.  
  245.  
  246.   PROCEDURE SetThreadReadyGivenTaskRef ( threadTRef: ThreadTaskRef; threadToSet: ThreadID ):OSErr;
  247.     PROCEDURE TBSetThreadReadyGivenTaskRef (threadTRef: ThreadTaskRef;
  248.                                             threadToSet: ThreadID ):OSErr; CODE ThreadTrap;
  249.     
  250.   BEGIN
  251.     INLINE( 0303CH,00410H);
  252.     RETURN TBSetThreadReadyGivenTaskRef (threadTRef, threadToSet);
  253.   END SetThreadReadyGivenTaskRef;
  254.  
  255.   PROCEDURE ThreadsAvailable( ) : BOOLEAN;
  256.   BEGIN
  257.     RETURN threadsAvailable;
  258.   END ThreadsAvailable;
  259.  
  260.   TYPE
  261.     TrapType = ( OSTrap, ToolTrap );
  262.     TypeID   = ( set, wrd );
  263.     OSType   = ARRAY[1..4] OF CHAR;
  264.  
  265.     WordTYPE = RECORD (* 16 bits *)
  266.                  CASE : TypeID OF
  267.                    set : s :  BITSET;
  268.                  | wrd : w :  WORD;
  269.                  END(*CASE*);
  270.                END(*RECORD*);
  271.    CONST
  272.     A0 = 8;
  273.     InitGrafTRAP               = 0A86EH;
  274.     GestaltTRAP                = 0A1ADH;
  275.     UnimplTRAP                 = 0009FH;
  276.   
  277.   PROCEDURE NGetTrapAddress(trapNum: WORD; trapType: TrapType): ADDRESS;
  278.     (* see Inside Mac IV-234. (AI 5.2.88)
  279.        trap nr from MDS 2.0 Disk 3/3  File: Traps.txt *)
  280.     (* only for 128k Rom traps ! *)
  281.     VAR adr: ADDRESS;
  282.   BEGIN
  283.     SETREG(D0,LONG(trapNum));
  284.     IF trapType = OSTrap THEN
  285.       INLINE(0A346H);  (* Bit 9 set; Bit 10 clear *)
  286.     ELSE
  287.       INLINE(0A746H);  (* Bit 9 set; Bit 10 set   *);
  288.     END;
  289.     adr:= REG(A0);
  290.     RETURN adr;
  291.   END NGetTrapAddress;
  292.  
  293.  
  294.   PROCEDURE NumToolboxTraps(): WORD;
  295.   BEGIN
  296.     IF NGetTrapAddress(VAL(CARDINAL,InitGrafTRAP),ToolTrap) =
  297.        NGetTrapAddress(VAL(CARDINAL,0AA6EH      ),ToolTrap) THEN
  298.       RETURN 0200H;
  299.     ELSE
  300.       RETURN 0400H;
  301.     END(*IF*);
  302.   END NumToolboxTraps;
  303.  
  304.  
  305.   PROCEDURE BitAND( a, b: WORD ): WORD;
  306.     VAR
  307.       r, x, y : WordTYPE;
  308.   BEGIN
  309.     x.w:= a;
  310.     y.w:= b;
  311.     r.s:= ( x.s * y.s );
  312.     RETURN r.w;
  313.   END BitAND;
  314.  
  315.  
  316.   PROCEDURE GetTrapType(theTrap: WORD): TrapType;
  317.   CONST
  318.     TrapMask = 0800H;
  319.   BEGIN
  320.     IF BitAND(theTrap,TrapMask) > VAL(WORD,0) THEN
  321.       RETURN ToolTrap;
  322.     ELSE
  323.       RETURN OSTrap;
  324.     END(*IF*);
  325.   END GetTrapType;
  326.  
  327.  
  328.   PROCEDURE TrapAvailable(theTrap: WORD): BOOLEAN;
  329.     CONST
  330.       TrapOffset = 07FFH;
  331.     VAR
  332.       tType: TrapType;
  333.   BEGIN
  334.     tType := GetTrapType(theTrap);
  335.     IF tType = ToolTrap THEN
  336.       theTrap := BitAND(theTrap, TrapOffset);
  337.       IF theTrap >= NumToolboxTraps() THEN
  338.         theTrap:= UnimplTRAP;
  339.       END(*IF*);
  340.     END(*IF*);
  341.     RETURN ( NGetTrapAddress(theTrap   , tType   ) <>
  342.              NGetTrapAddress(UnimplTRAP, ToolTrap) );
  343.   END TrapAvailable;
  344.   PROCEDURE GestaltAvailable(): BOOLEAN;
  345.     (* Should be available in systems >= 6.0.4, see IM VI 3-4 *)
  346.   BEGIN
  347.     RETURN TrapAvailable( GestaltTRAP );
  348.   END GestaltAvailable;
  349.  
  350.  
  351.   PROCEDURE Gestalt( selector: OSType; VAR response: LONGINT): OSErr;
  352.   BEGIN
  353.     SETREG(D0,selector); INLINE (GestaltTRAP);
  354.     response := REG(A0);
  355.     RETURN VAL(INTEGER,REG(D0))
  356.   END Gestalt;
  357.   
  358.   PROCEDURE ShortGestalt(selector: OSType): INTEGER;
  359.     VAR response: LONGINT; err: OSErr;
  360.   BEGIN
  361.     err := Gestalt(selector,response);
  362.     IF err = 0 THEN RETURN SHORT(response) ELSE RETURN 0 END;
  363.   END ShortGestalt;
  364.   
  365.  
  366.  
  367. BEGIN
  368.    threadsAvailable := GestaltAvailable();
  369.    IF threadsAvailable THEN
  370.      threadsAvailable :=  gestaltThreadMgrPresent
  371.                           IN VAL(BITSET, ShortGestalt(gestaltThreadMgrAttr));
  372.    END;(*IF*)
  373. END Thread.